home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / perl / cmpinclude.ph < prev    next >
Text File  |  1991-08-11  |  6KB  |  248 lines
  1. require 'stdio.ph';
  2. require 'setjmp.ph';
  3. sub TRUE {1;}
  4. sub FALSE {0;}
  5. sub OBJNULL {(( &object) &NULL);}
  6. sub fix {
  7.     local($x) = @_;
  8.     eval "($x)-> &FIX. &FIXVAL";
  9. }
  10. sub SMALL_FIXNUM_LIMIT {1024;}
  11. sub small_fixnum {
  12.     local($i) = @_;
  13.     eval "( &object)( &small_fixnum_table+ &SMALL_FIXNUM_LIMIT+($i))";
  14. }
  15. sub sf {
  16.     local($x) = @_;
  17.     eval "($x)-> &SF. &SFVAL";
  18. }
  19. sub lf {
  20.     local($x) = @_;
  21.     eval "($x)-> &LF. &LFVAL";
  22. }
  23. sub code_char {
  24.     local($c) = @_;
  25.     eval "( &object)( &character_table+($c))";
  26. }
  27. sub char_code {
  28.     local($x) = @_;
  29.     eval "($x)-> &ch. &ch_code";
  30. }
  31. sub char_font {
  32.     local($x) = @_;
  33.     eval "($x)-> &ch. &ch_font";
  34. }
  35. sub char_bits {
  36.     local($x) = @_;
  37.     eval "($x)-> &ch. &ch_bits";
  38. }
  39. sub s_fillp { &st_fillp;}
  40. sub s_self { &st_self;}
  41. sub type_of {
  42.     local($obje) = @_;
  43.     eval "(( &enum  &type)((( &object)($obje))-> &d. &t))";
  44. }
  45. sub endp {
  46.     local($obje) = @_;
  47.     eval " &endp1($obje)";
  48. }
  49. sub vs_org { &value_stack;}
  50. sub vs_push {
  51.     local($obje) = @_;
  52.     eval "(* &vs_top++ = ($obje))";
  53. }
  54. sub vs_pop {(*-- &vs_top);}
  55. sub vs_head { &vs_top[-1];}
  56. sub vs_mark { &object * &old_vs_top =  &vs_top;}
  57. sub vs_reset { &vs_top =  &old_vs_top;}
  58. sub vs_check { &if ( &vs_top >=  &vs_limit)  &vs_overflow();;}
  59. sub vs_check_push {
  60.     local($obje) = @_;
  61.     eval "( &vs_top >=  &vs_limit ? ( &object) &vs_overflow() : (* &vs_top++ = ($obje)))";
  62. }
  63. sub check_arg {
  64.     local($n) = @_;
  65.     eval " &if ( &vs_top -  &vs_base != ($n))  &check_arg_failed($n)";
  66. }
  67. sub MMcheck_arg {
  68.     local($n) = @_;
  69.     eval " &if ( &vs_top -  &vs_base < ($n))  &too_few_arguments();  &else  &if ( &vs_top -  &vs_base > ($n))  &too_many_arguments()";
  70. }
  71. sub vs_reserve {
  72.     local($x) = @_;
  73.     eval " &if( &vs_base+($x) >=  &vs_limit)  &vs_overflow();";
  74. }
  75. sub bds_org { &bind_stack;}
  76. sub bds_check { &if ( &bds_top >=  &bds_limit)  &bds_overflow();}
  77. sub bds_bind {
  78.     local($sym, $val) = @_;
  79.     eval "((++ &bds_top)-> &bds_sym = ($sym),  &bds_top-> &bds_val = ($sym)-> &s. &s_dbind, ($sym)-> &s. &s_dbind = ($val))";
  80. }
  81. sub bds_unwind1 {(( &bds_top-> &bds_sym)-> &s. &s_dbind =  &bds_top-> &bds_val, -- &bds_top);}
  82. sub ihs_org { &ihs_stack;}
  83. sub ihs_check { &if ( &ihs_top >=  &ihs_limit)  &ihs_overflow();}
  84. sub ihs_push {
  85.     local($function) = @_;
  86.     eval "(++ &ihs_top)-> &ihs_function = ($function);  &ihs_top-> &ihs_base =  &vs_base";
  87. }
  88. sub ihs_pop {
  89.     eval "( &ihs_top--)";
  90. }
  91. sub alloc_frame_id {
  92.     eval " &alloc_object( &t_spice)";
  93. }
  94. sub frs_org { &frame_stack;}
  95. sub frs_push {
  96.     local($class, $val) = @_;
  97.     eval " &if (++ &frs_top >=  &frs_limit)  &frs_overflow();  &frs_top-> &frs_lex =  &lex_env;  &frs_top-> &frs_bds_top =  &bds_top;  &frs_top-> &frs_class = ($class);  &frs_top-> &frs_val = ($val);  &frs_top-> &frs_ihs =  &ihs_top;  &setjmp( &frs_top-> &frs_jmpbuf)";
  98. }
  99. sub frs_pop {
  100.     eval " &frs_top--";
  101. }
  102. sub MMcons {
  103.     local($a,$d) = @_;
  104.     eval " &make_cons(($a),($d))";
  105. }
  106. sub MMcar {
  107.     local($x) = @_;
  108.     eval "($x)-> &c. &c_car";
  109. }
  110. sub MMcdr {
  111.     local($x) = @_;
  112.     eval "($x)-> &c. &c_cdr";
  113. }
  114. sub CMPcar {
  115.     local($x) = @_;
  116.     eval "($x)-> &c. &c_car";
  117. }
  118. sub CMPcdr {
  119.     local($x) = @_;
  120.     eval "($x)-> &c. &c_cdr";
  121. }
  122. sub CMPcaar {
  123.     local($x) = @_;
  124.     eval "($x)-> &c. &c_car-> &c. &c_car";
  125. }
  126. sub CMPcadr {
  127.     local($x) = @_;
  128.     eval "($x)-> &c. &c_cdr-> &c. &c_car";
  129. }
  130. sub CMPcdar {
  131.     local($x) = @_;
  132.     eval "($x)-> &c. &c_car-> &c. &c_cdr";
  133. }
  134. sub CMPcddr {
  135.     local($x) = @_;
  136.     eval "($x)-> &c. &c_cdr-> &c. &c_cdr";
  137. }
  138. sub CMPcaaar {
  139.     local($x) = @_;
  140.     eval "($x)-> &c. &c_car-> &c. &c_car-> &c. &c_car";
  141. }
  142. sub CMPcaadr {
  143.     local($x) = @_;
  144.     eval "($x)-> &c. &c_cdr-> &c. &c_car-> &c. &c_car";
  145. }
  146. sub CMPcadar {
  147.     local($x) = @_;
  148.     eval "($x)-> &c. &c_car-> &c. &c_cdr-> &c. &c_car";
  149. }
  150. sub CMPcaddr {
  151.     local($x) = @_;
  152.     eval "($x)-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_car";
  153. }
  154. sub CMPcdaar {
  155.     local($x) = @_;
  156.     eval "($x)-> &c. &c_car-> &c. &c_car-> &c. &c_cdr";
  157. }
  158. sub CMPcdadr {
  159.     local($x) = @_;
  160.     eval "($x)-> &c. &c_cdr-> &c. &c_car-> &c. &c_cdr";
  161. }
  162. sub CMPcddar {
  163.     local($x) = @_;
  164.     eval "($x)-> &c. &c_car-> &c. &c_cdr-> &c. &c_cdr";
  165. }
  166. sub CMPcdddr {
  167.     local($x) = @_;
  168.     eval "($x)-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_cdr";
  169. }
  170. sub CMPcaaaar {
  171.     local($x) = @_;
  172.     eval "($x)-> &c. &c_car-> &c. &c_car-> &c. &c_car-> &c. &c_car";
  173. }
  174. sub CMPcaaadr {
  175.     local($x) = @_;
  176.     eval "($x)-> &c. &c_cdr-> &c. &c_car-> &c. &c_car-> &c. &c_car";
  177. }
  178. sub CMPcaadar {
  179.     local($x) = @_;
  180.     eval "($x)-> &c. &c_car-> &c. &c_cdr-> &c. &c_car-> &c. &c_car";
  181. }
  182. sub CMPcaaddr {
  183.     local($x) = @_;
  184.     eval "($x)-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_car-> &c. &c_car";
  185. }
  186. sub CMPcadaar {
  187.     local($x) = @_;
  188.     eval "($x)-> &c. &c_car-> &c. &c_car-> &c. &c_cdr-> &c. &c_car";
  189. }
  190. sub CMPcadadr {
  191.     local($x) = @_;
  192.     eval "($x)-> &c. &c_cdr-> &c. &c_car-> &c. &c_cdr-> &c. &c_car";
  193. }
  194. sub CMPcaddar {
  195.     local($x) = @_;
  196.     eval "($x)-> &c. &c_car-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_car";
  197. }
  198. sub CMPcadddr {
  199.     local($x) = @_;
  200.     eval "($x)-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_car";
  201. }
  202. sub CMPcdaaar {
  203.     local($x) = @_;
  204.     eval "($x)-> &c. &c_car-> &c. &c_car-> &c. &c_car-> &c. &c_cdr";
  205. }
  206. sub CMPcdaadr {
  207.     local($x) = @_;
  208.     eval "($x)-> &c. &c_cdr-> &c. &c_car-> &c. &c_car-> &c. &c_cdr";
  209. }
  210. sub CMPcdadar {
  211.     local($x) = @_;
  212.     eval "($x)-> &c. &c_car-> &c. &c_cdr-> &c. &c_car-> &c. &c_cdr";
  213. }
  214. sub CMPcdaddr {
  215.     local($x) = @_;
  216.     eval "($x)-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_car-> &c. &c_cdr";
  217. }
  218. sub CMPcddaar {
  219.     local($x) = @_;
  220.     eval "($x)-> &c. &c_car-> &c. &c_car-> &c. &c_cdr-> &c. &c_cdr";
  221. }
  222. sub CMPcddadr {
  223.     local($x) = @_;
  224.     eval "($x)-> &c. &c_cdr-> &c. &c_car-> &c. &c_cdr-> &c. &c_cdr";
  225. }
  226. sub CMPcdddar {
  227.     local($x) = @_;
  228.     eval "($x)-> &c. &c_car-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_cdr";
  229. }
  230. sub CMPcddddr {
  231.     local($x) = @_;
  232.     eval "($x)-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_cdr-> &c. &c_cdr";
  233. }
  234. sub CMPfuncall { &funcall;}
  235. sub cclosure_call { &funcall;}
  236. sub Cnil {(( &object)& &Cnil_body);}
  237. sub Ct {(( &object)& &Ct_body);}
  238. sub CMPmake_fixnum {
  239.     local($x) = @_;
  240.     eval "(((( &FIXtemp=($x))+1024)&-2048)==0? &small_fixnum( &FIXtemp): &make_fixnum( &FIXtemp))";
  241. }
  242. sub Creturn {
  243.     local($v) = @_;
  244.     eval " &return(( &vs_top= &vs,($v)))";
  245. }
  246. sub Cexit { &return(( &vs_top= &vs,0));}
  247. 1;
  248.